home *** CD-ROM | disk | FTP | other *** search
/ Ian & Stuart's Australian Mac: Not for Sale / Another.not.for.sale (Australia).iso / fade into you / being there / Issues & Ideas / Anonymous remailers / Remailers / hal's.remailer < prev    next >
Text File  |  1994-11-12  |  13KB  |  444 lines
  1. Cryptographically-Protected Anonymous Remailer (Perl based)
  2. Hal Finney
  3. Based on work by Eric Hughes
  4.  
  5. Note: the remailer is currently an experimental product.  No liability
  6. can be accepted for problems, including lost or garbled mail.  People
  7. who operate remailers should be aware that malicious or abusive mail
  8. could be sent through their remailers, and conceivably they might be
  9. held responsible for the contents of such mail.
  10.  
  11. The remailing scripts are designed to be used on a Unix-based system
  12. which uses the "sendmail" program for mail delivery.  They intercept
  13. incoming mail by the use of a ".forward" file in the user's home directory,
  14. filter the mail looking for remail requests, and put other messages into
  15. the user's normal mail directory.
  16.  
  17. Here is how the files are organized on my system:
  18.  
  19. Home directory:
  20.     .forward        Command to run the remailer script
  21. Home/remail:
  22.     maildelivery        Config file for slocal.pl script
  23.     slocal.pl        Replacement for slocal, written in perl
  24.     remail.pl        Perl script for remailing requests
  25.     pgpmail.pl        Perl script for PGP decryption requests
  26.     recurse.pl        Perl script for calling slocal again
  27. Home/remail/pgp:
  28.     pgp            PGP executable
  29.     pgp.hlp            Help file for PGP
  30.     config.txt        PGP config file
  31.     randseed.pgp        Random bytes used by PGP
  32.     pubring.pgp        PGP public key ring
  33.     secring.pgp        PGP secret key ring
  34.  
  35.  
  36. Some customization will be needed of the files below.  The first line of
  37. each perl script contains the path to the local version of perl.  Edit
  38. these if needed to correspond to the local location of perl.  Edit the
  39. .forward file to correspond to the location you put the remail directory
  40. if different from mine.  Also edit the remail.pl script where it puts in
  41. the mail address of the remailer to correspond to your own mail address.
  42.  
  43. It's best to test the basic remailer functions before trying to get the PGP
  44. working.  The slocal.pl script has some debugging functions built in which
  45. write to /dev/null but which can be changed to write to a log file on
  46. /tmp.  This can be useful to track down remailer failures.
  47.  
  48. Once these work, the next step is to get PGP running on your system.  For
  49. simplicity, I assume that PGP is in a subdirectory of the remailer.  If
  50. this is different for you, edit the pgpmail.pl script for the location of
  51. PGP on your system.  Also, edit the PGPPASS entry in the pgpmail.pl
  52. script to correspond to the pass phrase you will use for your PGP remailer.
  53.  
  54. Create a key for your remailer, using this same pass phrase.  Make sure this
  55. is the key which will be used by default to decrypt incoming messages.
  56. This can be set in config.pgp, or by default PGP will use the most recently
  57. created key.
  58.  
  59. The remailer creates two archive files.  archive.pgp contains the messages
  60. which are recognized as being for PGP.  archive.remail contains the messages
  61. which are recognized as remailing requests.  Note that an encrypted remailing
  62. request will first go into archive.pgp in encrypted form, then will also
  63. be added to archive.remail in its decrypted form.
  64.  
  65. Please report problems with the remailer to me at 74076.1041@compuserve.com.
  66.  
  67. .forward file:
  68. ---------------------------- cut here -------------------------------
  69. "|/alum/hal/remail/slocal.pl"
  70. ---------------------------- cut here -------------------------------
  71.  
  72. slocal.pl
  73. ---------------------------- cut here -------------------------------
  74. #!/usr/bin/perl
  75.  
  76. # slocal subset
  77.  
  78. # Read maildelivery file in .slocal format.
  79. # Returns arrays @field, @pat, @action, @res, @cmd.
  80. sub read_delivery {
  81.     open (IN, "maildelivery")  ||  die $?;
  82.  
  83.     while (<IN>) {
  84.     next if /^\s*#/ || /^\s*$/;    # Skip blank and comment lines
  85.     @line = split (" ");
  86.     undef(@mailline);
  87.     for ($i=0; $i<=$#line; $i++) {
  88.         $field = $line[$i];
  89.         if ($field =~ /^"/) {    # Re-join args collected by quotes
  90.         while ((substr($field,-1,1) ne '"')  &&  (++$i<=$#line)) {
  91.             $field .= ' ' . $line[$i];
  92.         }
  93.         substr($field,0,1) = '';
  94.         substr($field,-1,1) = '';
  95.         }
  96.         push (@mailline, $field);
  97.     }            
  98.     die "Incorrect number of fields on line:\n  ". $_ if @mailline != 5;
  99.     ($field[$ln], $pat[$ln], $action[$ln], $res[$ln], $cmd[$ln]) =
  100.             @mailline;
  101.     # Lower-case field and pattern
  102.     $field[$ln] =~ tr/A-Z/a-z/;
  103.     $pat[$ln] =~ tr/A-Z/a-z/;
  104.     ++$ln;
  105.     }
  106. }
  107.  
  108. # Call to read mail header from parameter, e.g. read_header(STDIN).
  109. # Returns headers and fields in associative array %head.
  110. # Return header as a string in $head.
  111. sub read_header {
  112.     local ($/,$*,$s) = ("",1,@_);    # Paragraph mode
  113.     $head = <$s>;        # Read header
  114.     ($head1=$head) =~ tr/A-Z/a-z/;    # Lower case everything
  115.     chop $head1;        # Delete trailing newline
  116.     $head1 =~ s/\n\s+/ /g ;    # Merge continuation lines
  117.     %head = ("FRONT\001", split(/^([-\w]+):/, $head1));
  118. }
  119.  
  120. # Defines and subroutines for BSD-style mail delivery.
  121. $LOCK_SH = 1;
  122. $LOCK_EX = 2;
  123. $LOCK_NB = 4;
  124. $LOCK_UN = 8;
  125. sub lock {
  126.   local ($mbox) = @_;
  127.   flock ($mbox, $LOCK_EX);
  128.   # and, in case someone appended while we were waiting...
  129.   seek($mbox, 0, 2);
  130. }
  131. sub unlock {
  132.   local ($mbox) = @_;
  133.   flock ($mbox, $LOCK_UN);
  134. }
  135.  
  136. # Call as &maildeliver ($mailbox, $message).
  137. # Delivers the message to the specified mailbox using BSD conventions.
  138. # Returns $mailstat = 1 if it fails, $mailstat = 0 if it succeeds.
  139. #
  140. sub maildeliver {
  141.     local ($*, $mbox, $msg) = (1, @_);
  142.     # Eliminate trailing blank lines
  143.     chop($msg) while substr($msg,-1,1) eq "\n";
  144.  
  145.     # Quote '^From ' lines
  146.     $msg =~ s/\nFrom /\n>From /g;
  147.  
  148.     open (MBOX, ">>$mbox") || ($mailstat = 1 && return);
  149.     &lock(MBOX);
  150.     print MBOX $msg, "\n\n";
  151. # Wed Nov 25 09:39:04 1992
  152. # Had a bug where we would do just an unlock here.  Since we hadn't
  153. # closed the FD, another process which immediately grabbed a lock
  154. # which would do a seek to the end, didn't always find the right spot
  155. # due to buffering.  So we close instead, which automatically releases
  156. # the lock.
  157. #   &unlock(MBOX);
  158.     close(MBOX);
  159.     $mailstat = 0;
  160. }
  161.  
  162.  
  163. # Exercise the above subroutines
  164.  
  165.  
  166. # Prepare for debugging logging
  167.  
  168. #open (LOG, ">/tmp/LOG$$") || die "Can't log: $!\n";
  169. open (LOG, ">/dev/null");
  170. select(LOG);
  171. print "Starting process $$\n";
  172. print "Environment = ", join(',',%ENV), "\n";
  173. print "UID = $<; EUID = $>; CWD = " . `pwd`;
  174.  
  175. # Parse optional command-line argument, or use effective user ID.
  176. ($user, $passwd, $uid, $gid, $quota, $comm, $gcos, $dir, $shell) =
  177.     ($user = $ARGV[0]) ? getpwnam($user) : getpwuid($>);
  178.     
  179. die "Usage: $0 [username]\n" if $dir eq '';
  180.  
  181. $mbox = "/usr/spool/mail/$user";
  182. chdir("$dir/remail") || die "Chdir failure: $!\n";
  183. print "MBOX = $mbox; CWD = " . `pwd`;
  184.  
  185. # Some systems run mail delivery with a pretty bare environment.
  186. $ENV{'USER'} = $user;
  187. $ENV{'HOME'} = $dir;
  188. substr($ENV{'PATH'},0,0) = ".:";
  189. $gcos =~ s/&/$user/;
  190. $gcos =~ s/,+$//;
  191. $ENV{'USERNAME'} = $gcos;    # Remailer uses this
  192. print "Environment = ", join(',',%ENV), "\n";
  193.  
  194. # My version of Perl (4.0) needs this or unsuccessful pipe commands
  195. # cause it to silently die.
  196. $SIG{'PIPE'} = 'IGNORE';
  197.  
  198. # Read things...
  199. &read_delivery ;
  200. &read_header(STDIN);
  201. $msg = join ('', $head, <STDIN>);
  202.  
  203. for $i (0 .. $#field) {
  204.     $field = $field[$i];
  205.     if (defined ($head{$field})  ||  $field eq "*") {
  206.     if (($field eq "*")  ||  ($head{$field} =~ /$pat[$i]/)  ||
  207.             $pat[$i] eq "") {
  208. print "Match on field $field, pattern $pat[$i], contents are: $head{$field}\n";
  209.         # Here we have a match.
  210.         next if ($delivered && $res[$i] eq '?');
  211.         if ($action[$i] eq "file" || $action[$i] eq ">") {
  212. print "Delivering to file $cmd[$i]\n";
  213.         &maildeliver ( $cmd[$i], $msg );
  214. print "(File write returned status: $mailstat)\n";
  215.         if ($res[$i] =~ /A|\?/  && $mailstat == 0) {
  216. print "Now delivered.\n";
  217.             $delivered = 1;
  218.         }
  219.         next;
  220.         }
  221.         if ($action[$i] eq "pipe" || $action[$i] eq "|") {
  222. print "Delivering to pipe $cmd[$i]\n";
  223.         open (PIPE, "|" . $cmd[$i]);
  224.         print(PIPE $msg);
  225.         close(PIPE);
  226. print "$?\n";
  227.         $mailstat = $?;
  228. print "(Pipe returned status: $mailstat)\n";
  229.         if ($res[$i] =~ /A|\?/  && $mailstat == 0) {
  230. print "Now delivered.\n";
  231.             $delivered = 1;
  232.         }
  233.         next;
  234.         }
  235.     }
  236.     }
  237. }
  238.  
  239. # Possibly deliver to default mailbox, found from command-line argument
  240. if (!$delivered) {
  241. print "Delivering to regular mailbox: $mbox\n";
  242.     &maildeliver ( $mbox, $msg );
  243. print "(Result status: $mailstat)\n";
  244. }
  245. ---------------------------- cut here -------------------------------
  246.  
  247.  
  248. maildelivery
  249. ---------------------------- cut here -------------------------------
  250. #
  251. # field                 pattern action/ string 
  252. #                               result  (quote included spaces)
  253. #
  254. Request-Remailing-To    ""      pipe R  remail.pl
  255. Request-Remailing-To    ""      file A  archive.remail
  256. # Make 'Anon-To' a synonym for Request-Remailing-To
  257. # (remail.pl has to know about this synonym as well)
  258. Anon-To            ""    pipe R  remail.pl
  259. Anon-To            ""    file A  archive.remail
  260. Encrypted               PGP     pipe R  pgpmail.pl
  261. Encrypted               PGP     file A  archive.pgp
  262. *                       ""      pipe ?  recurse.pl
  263. ---------------------------- cut here -------------------------------
  264.  
  265.  
  266. remail.pl:
  267. ---------------------------- cut here -------------------------------
  268. #!/usr/bin/perl
  269.  
  270. # Remailing perl script, based on that of Eric Hughes
  271.  
  272. # Set this to be what you would like it to go out as.
  273. # slocal.pl sets environment variable USERNAME from the password file.
  274. $remail_header = "Remailed-By: $ENV{'USERNAME'} <hal@alumni.caltech.edu>\n" ;
  275.  
  276. while (<>) {
  277.     s/[ \t\r]*$// ;
  278.         last if /^$/ ;
  279.         $subject = $_ if /^Subject:/ ;
  280.         if (/^Request-Remailing-To:/  ||  /^Anon-To:/) {
  281.                 chop ;
  282.                 s/^.*:// ;
  283.                 $addressee = $_ ;
  284.         }
  285. }
  286.  
  287. #open( OUTPUT, ">foo" ) || die "Cannot open 'foo'." ;
  288. open( OUTPUT, "| /usr/lib/sendmail " . $addressee ) ;
  289. select( OUTPUT ) ;
  290.  
  291. print "To:" . $addressee . "\n" ;
  292. print "From: nobody\n" ;
  293. print $subject ;
  294. print $remail_header;
  295.  
  296. #
  297. # check to see if there are header lines in the body to collapse 
  298. #   into the full header.
  299. #
  300.  
  301. if ( $_ = <> ) {
  302.     s/[ \t\r]*$// ;
  303.         if (/^##$/) {
  304.                 # do nothing if the pasting token appears
  305.                 # the rest of the body will be directly appended
  306.                 # this allows for extra header lines to be added
  307.         } else {
  308.                 # normal line
  309.                 print "\n" ;
  310.                 print $_ ;
  311.         }
  312. } else {
  313.         # empty body
  314.         exit ;
  315. }
  316.  
  317. print <>;
  318. ---------------------------- cut here -------------------------------
  319.  
  320.  
  321. recurse.pl:
  322. ---------------------------- cut here -------------------------------
  323. #!/usr/bin/perl
  324. # Call slocal recursivelly, first checking the message body for the
  325. # pasting token "::" and appending any following lines before a blank
  326. # line to the header.
  327.  
  328.   # First read in the whole header.
  329.  
  330. while (<>) {
  331.     s/[ \t\r]*$// ;
  332.         last if /^$/ ;
  333.         $header .= $_ ;
  334. }
  335.  
  336.   # We have just read the last line in the header.
  337.   # Now we check to see if there is a pasting operator.
  338.  
  339. if ( ( $_ = <> ) && /^::[ \t\r]*$/ ) {
  340.         while (<>) {
  341.         s/[ \t\r]*$// ;
  342.                 last if /^$/ ;
  343.                 $header .= $_ ;
  344.         }
  345. } else {
  346.         # There is either an empty body or no pasting operator
  347.         #   Thus exit with a return code of 1 to indicate that
  348.         #   the mail has not been delivered.
  349.                 exit( 1 );
  350. }
  351.  
  352. # There was a header pasting operator.
  353. #   So we open 'slocal.pl' as a pipe, effectively redelivering the mail
  354. #   back to ourselves.
  355.  
  356. #open( OUTPUT, ">foo" ) ;
  357. open( OUTPUT, "| slocal.pl");
  358. select( OUTPUT ) ;
  359.  
  360. # Now just print out the message
  361.  
  362. print $header ;
  363. print "\n" ; 
  364. print <>;
  365. ---------------------------- cut here -------------------------------
  366.  
  367.  
  368. pgpmail.pl:
  369. ---------------------------- cut here -------------------------------
  370. #!/usr/bin/perl
  371.  
  372. # Perl script for passing PGP portions through PGP and leaving the
  373. # rest alone.
  374. # This version just does 1 PGP portion, and it has to be just after
  375. # the header.  This is for security, so people can't send us packets
  376. # to be decrypted and get them back.
  377.  
  378. # Scratch file names
  379. $scr1 = "/tmp/pm1_" . $$ ;
  380. $scr2 = "/tmp/pm2_" . $$ ;
  381.  
  382. open (STDOUT, "| recurse.pl");
  383.  
  384. #print "Doing header...\n" ;
  385. # Print out message header.
  386. while (<>) {
  387.     last if (/^$/) ;
  388.     next if /^Encrypted:/ ;    # Delete 'Encrypted' header
  389.     print $_ ;
  390. }
  391.  
  392.     print "\n" ;
  393.  
  394. # Eat blank lines
  395. while (<>) {
  396.     last if (!/^$/) ;
  397. }
  398. #print "Blank lines eaten...\n" ;
  399.  
  400. if (/^-----BEGIN PGP MESSAGE-----$/) {
  401.     #print "Found PGP header...\n" ;
  402.     open ( OUT1, ">" .  $scr1 ) ;
  403.  
  404.     print OUT1 $_ ;
  405.  
  406.     while ( <> ) {
  407.     print OUT1 $_ ;
  408.     last if (/^-----END PGP MESSAGE-----$/) ;
  409.     }
  410.  
  411.     close ( OUT1 ) ;
  412.  
  413.     #print "Printing PGP header to file " . $scr1 . "\n" ;
  414.  
  415.     $stat = system ( "PGPPATH=./pgp PGPPASS=yourpassphrase  ./pgp/pgp -f " . "<" . $scr1 . " 2>/dev/null >" . $scr2 ) ;
  416.  
  417.     if ( $stat == 0 ) {
  418.     #print "PGP Succeeded\n" ;
  419.     open ( IN1, $scr2 ) ;    # Use output if PGP succeeded
  420.     } else {
  421.     #print "PGP Failed\n" ;
  422.     open ( IN1, $scr1 ) ;    # Ignore output if PGP failed
  423.     }
  424.  
  425.     #print "Copying results of PGP run...\n" ;
  426.     while ( <IN1> ) {
  427.     s/\r$// ;        # Remove trailing CR's
  428.     print $_ ;
  429.     }
  430.  
  431.     unlink ( $scr1 ) ;        # Remove scratch files
  432.     unlink ( $scr2 ) ;
  433. } else {
  434.     print $_ ;
  435. }
  436.  
  437. #print "Copying remainder of file...\n" ;
  438.  
  439. #Copy remainder of file
  440. print <>;
  441. ---------------------------- cut here -------------------------------
  442.  
  443.  
  444.